(defpackage :cl-gserver.config
  (:use :cl)
  (:nicknames :config)
  (:export #:config-from
           #:retrieve-section
           #:retrieve-value
           #:retrieve-keys
           #:merge-config))

(in-package :cl-gserver.config)

(defun config-from (config-string)
  "Parses the given config-string, represented by common lisp s-expressions.
The config is composed of plists in a hierarchy.

This function parses (run through `cl:read`) the given config string.
The config string can be generated by:

```
(let ((*print-case* :downcase))
  (prin1-to-string '(defconfig 
                     (:foo 1
                      :bar 2))))
```
Or just be given by reading from a file.
Notice the 'config' s-expr must start with the root `car` 'defconfig'.
"
  (when config-string
    (let* ((stream (make-string-input-stream config-string))
           (config (read stream)))
      (if (string= "defconfig" (string-downcase (symbol-name (car config))))
          (cadr config)
          (error "Unrecognized config!")))))

(defun retrieve-section (config section)
  "Retrieves the given named section which should be a (global) `symbol` (a key).
A section usually is a plist with additional configs or sub sections.
This function looks only in the root hierarchy of the given config."
  (getf config section))

(defun retrieve-value (section key)
  "Retrieves the value for the given key and section."
  (getf section key))

(defun retrieve-keys (config)
  "Retrieves all section keys"
  (loop :for key :in config :by #'cddr
        :collect key))

(defun merge-config (config fallback-config)
  "Merges config. 
`config` specifies a config that overrides what exists in `fallback-config`.
`fallback-config` is a default. If something doesn't exist in `config` it is taken from `fallback-config`.
Both `config` and `fallback-config` must be plists, or a 'config' that was the output of `config-from`."
  (cond
    ((and config fallback-config)
     (%merge-config nil config fallback-config))
    (t (if config config fallback-config))))

(defun %merge-config (key config fallback)
  (cond
    ((and (not (null config)) (listp config) (not (null fallback)) (listp fallback))
     (let* ((keys (union (retrieve-keys config) (retrieve-keys fallback)))
            (result (loop :for key :in keys
                          :append (%merge-config
                                   key
                                   (retrieve-value config key)
                                   (retrieve-value fallback key)))))
       (if key
           `(,key ,result)
           result)))
    ((and (listp config) (null fallback))
     `(,key ,config))
    ((and (or (null config) (not (listp config)))
          (and (not (null fallback)) (listp fallback)))
     `(,key ,fallback))
    (t (if config
           `(,key ,config)
           `(,key ,fallback)))))
